home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue27 / archaeop / DinoSource / WindowMenu.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-09-17  |  6.4 KB  |  196 lines
  1. unit WindowMenu;
  2.  
  3. interface
  4.  
  5. implementation
  6.  
  7. uses
  8.   Windows, Messages, CommonStuff, Menus, Forms, SysUtils, Dialogs;
  9.  
  10. type
  11.   TWindowMenu = class(TObject)
  12.   private
  13.     FWindowMenu,
  14.     FWindowMenuOption: TMenuItem;
  15.   protected
  16.     procedure DoWindowMenu(Sender: TObject);
  17.     procedure DoWindowMenuClick(Sender: TObject);
  18.     procedure DoWindowItemClick(Sender: TObject);
  19.     procedure SetWindowMenu(Value: Boolean);
  20.   public
  21.     constructor Create;
  22.     destructor Destroy; override;
  23.   end;
  24.  
  25. resourcestring
  26.   SWindow = 'W&indow';             //Default Window menu caption
  27.   SInspector = 'Object Inspector'; //Object Inspector window caption
  28.   SWindowMenu = '&Window menu';    //Window menu toggle option
  29.  
  30. const
  31.   SMainMenu = 'MainMenu1'; //Delphi's main form TMainMenu component
  32.   SHelp = 'HelpMenu';      //Delphi's help menu component
  33.   SFormat = '&%d %s';      //Format for Window menu item
  34.   SIconCaptionClass = '#32772'; //Class name of an NT 3.5 icon caption
  35.   //Registry strings
  36.   SRegWindowMenu = 'Window Menu';
  37.   SRegWindowMenuName = 'Window Menu Caption';
  38.  
  39. constructor TWindowMenu.Create;
  40. begin
  41.   inherited Create;
  42.   //Make sure there is an options menu - bear in mind
  43.   //that the other options code might not be being used
  44.   Stuff.AddOptionsItem;
  45.   //Set up Window menu options menu item
  46.   FWindowMenuOption := NewItem(SWindowMenu, 0,
  47.     Stuff.Ini.ReadBool(SRegSection, SRegWindowMenu, False),
  48.     True, DoWindowMenu, 0, '');
  49.   //Insert the menu item
  50.   Stuff.FOptions.Add(FWindowMenuOption);
  51.   //Set the window menu as appropriate
  52.   SetWindowMenu(FWindowMenuOption.Checked);
  53. end;
  54.  
  55. destructor TWindowMenu.Destroy;
  56. begin
  57.   //Save Window menu existence state
  58.   Stuff.Ini.WriteBool(SRegSection,
  59.     SRegWindowMenu, FWindowMenuOption.Checked);
  60.   //Delete Window menu
  61.   SetWindowMenu(False);
  62.   inherited Destroy
  63. end;
  64.  
  65. procedure TWindowMenu.DoWindowMenu(Sender: TObject);
  66. begin
  67.   //When user toggles Window menu option, set
  68.   //checkmark and set Window menu accordingly
  69.   with Sender as TMenuItem do
  70.   begin
  71.     Checked := not Checked;
  72.     SetWindowMenu(Checked)
  73.   end
  74. end;
  75.  
  76. procedure TWindowMenu.DoWindowMenuClick(Sender: TObject);
  77. var
  78.   Loop, Count, OldCount, PID: Integer;
  79.   Item: TMenuItem;
  80.   Wnd: HWnd;
  81.   WndClass, WndCaption: array[0..255] of Char;
  82. begin
  83.   //Delphi repetitively calls the OnClick events of the
  84.   //main menu items to allow IDE code to en/disable
  85.   //speedbuttons as necessary. We will only execute
  86.   //this code if it is a real menu click (Sender =
  87.   //the menu item) - not a fake one from Delphi (where
  88.   //Sender = the main window)
  89.   if Sender = FWindowMenu then
  90.   begin
  91.     Count := 0;
  92.     //It would normally be sensible to delete the old items
  93.     //and then add new items. But for some reason that goes
  94.     //screwy UI-wise, so instead we add the new ones and
  95.     //then delete the old ones
  96.     //So, how many Window menu items were there?
  97.     OldCount := FWindowMenu.Count;
  98.     //Add new menu items for current windows
  99.     Wnd := GetWindow(Application.Handle, gw_HWndFirst);
  100.     while Wnd <> 0 do
  101.     begin
  102.       GetClassName(Wnd, WndClass, 255);
  103.       GetWindowThreadProcessID(Wnd, @PID);
  104.       //We only want windows in the Window menu
  105.       //that are... visible, enabled, have a caption,
  106.       //are not icon captions, are part of the Delphi
  107.       //process and are not the Application window
  108.       if IsWindowVisible(Wnd) and
  109.          IsWindowEnabled(Wnd) and
  110.          (GetWindowText(Wnd, WndCaption, 255) > 0) and
  111.          (PID = GetCurrentProcessID) and
  112.          (StrPas(WndClass) <> SIconCaptionClass) and
  113.          (StrPas(WndClass) <> Application.ClassName) then
  114.       begin
  115.         Inc(Count);
  116.         //Make a new menu item, remembering to put the
  117.         //checkmark on the currently selected page
  118.         Item := NewItem(Format(SFormat, [Count, StrPas(WndCaption)]), 0,
  119.           Wnd = Screen.ActiveCustomForm.Handle,
  120.           True, DoWindowItemClick, 0, '');
  121.         Item.RadioItem := True;
  122.         //Set up some unique group index to make
  123.         //menu items work like radio buttons
  124.         Item.GroupIndex := 57;
  125.         //Put F11 next to Object Inspector item as a reminder
  126.         if StrPas(WndCaption) = SInspector then
  127.           Item.ShortCut := vk_F11; //Don't use TextToShortCut!!
  128.         FWindowMenu.Add(Item);
  129.         //Ensure the menu item has a reference to the relevant form
  130.         Item.Tag := Wnd;
  131.       end;
  132.       Wnd := GetWindow(Wnd, gw_HWndNext)
  133.     end;
  134.     //Add About menu item
  135.     FWindowMenu.Add(NewLine);
  136.     FWindowMenu.Add(NewItem(SAbout, 0, False, True, Stuff.DoAbout, 0, ''));
  137.     //Now delete the old (potentially wrong) window menu items
  138.     for Loop := 1 to OldCount do
  139.       FWindowMenu.Items[0].Free;
  140.   end
  141. end;
  142.  
  143. procedure TWindowMenu.DoWindowItemClick(Sender: TObject);
  144. begin
  145.   //Restore selected window (in case it was minimised)
  146.   PostMessage((Sender as TMenuItem).Tag, wm_SysCommand, sc_Restore, 0);
  147.   //Make selected window active
  148.   SetForegroundWindow((Sender as TMenuItem).Tag)
  149. end;
  150.  
  151. procedure TWindowMenu.SetWindowMenu(Value: Boolean);
  152. var
  153.   FHelpMenuItem,
  154.   FMainMenuItem: TMenuItem;
  155. begin
  156.   if Value then
  157.   begin
  158.     //This finds the Help menu, which the Window menu will sit before
  159.     FHelpMenuItem := GetComponent(Application.MainForm, SHelp, SGenericError + SHelp) as TMenuItem;
  160.     //This adds a Window menu onto the end of Delphi's main menu
  161.     //with a caption read from the registry (some people are fussy
  162.     //about main menu captions)
  163.     FWindowMenu := NewItem(
  164.       Stuff.Ini.ReadString(SRegSection, SRegWindowMenuName, SWindow),
  165.       0, False, True, DoWindowMenuClick, 0, '');
  166.     //Add a dummy menu item to allow later manipulation logic to work
  167.     //If we don't, the menu ends up elsewhere on the screen
  168.     FWindowMenu.Add(NewLine);
  169.     //Get starting point for new main menu items
  170.     FMainMenuItem := Application.MainForm.Menu.Items;
  171.     FMainMenuItem.Add(FWindowMenu);
  172.     //Make new Window menu sit before the Help menu
  173.     FHelpMenuItem.MenuIndex := FMainMenuItem.Count;
  174.   end
  175.   else
  176.   begin
  177.     //This deletes the Window menu
  178.     FWindowMenu.Free;
  179.     FWindowMenu := nil
  180.   end
  181. end;
  182.  
  183. var
  184.   WindowMenuObject: TWindowMenu;
  185.  
  186. initialization
  187.   try
  188.     WindowMenuObject := TWindowMenu.Create
  189.   except
  190.     on E: Exception do
  191.       ShowMessage(SSetupError + ': ' + E.Message)
  192.   end
  193. finalization
  194.   WindowMenuObject.Free
  195. end.
  196.